home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / vol6n21.arc / SUBPROG2.BAS < prev   
BASIC Source File  |  1987-11-17  |  3KB  |  80 lines
  1.  
  2.  
  3. '-----------------------------------------------------------------------------
  4. ' File Name: SUBPROG2.BAS
  5. ' Routines : Hercules.there
  6.  
  7. ' Written  : 07/25/87 by Mark Novisoff
  8. ' Changes  : none
  9.  
  10. ' Comments : none
  11.  
  12. '-----------------------------------------------------------------------------
  13. Sub Hercules.there (Hercules.status%) Static
  14.  
  15. ' Description - Determines if a Hercules card is in the system
  16.  
  17. ' After calling this routine, Hercules.status% is 0 (no adapter present)
  18. ' or 1 (adapter is present).
  19.     
  20.     Hercules.status%=0        ' set the variable to 0
  21.  
  22.     Status.port%=&h3ba        ' the Hercules status port
  23.     Old.status%=INP(Status.port%)    ' get the current status
  24.     Old.status%=Old.status% AND &h80 ' isolate bit 7 for comparison
  25.  
  26.     For N%=1 to 6400        ' should be enough tests
  27.       Now.status%=INP(Status.port%)    ' get the current status
  28.       Now.status%=Now.status% AND &h80 ' isolate bit 7 for comparison
  29.       IF Now.status%<>Old.status% then ' If the status changes
  30.         N%=6400            ' then it probably is a Hercules card
  31.       End if            ' so end the loop
  32.                       ' Note that in QB 3.0, you can say
  33.                     ' "Exit for" instead of N%=6400
  34.     Next  
  35.         
  36.     IF Now.status%=Old.status% THEN ' If it cannot be a hercules
  37.       Exit Sub            ' then return to main program
  38.     End If
  39.  
  40. Try.change.memory:            ' If we can change a word in memory
  41.                     ' and read back the same value, then
  42.                     ' there must be 32K of memory and
  43.                     ' a Herc (or compatible) is present
  44.                     
  45.     Def Seg=&hb000            ' Point to monochrome memory
  46.     Low.byte%=Peek(&h7ffe)        ' Least significant byte is saved
  47.     High.byte%=Peek(&h7fff)        '  and most significant byte                    
  48.  
  49.     Poke &h7ffe,&haa        ' Our signature is &h55aa
  50.     Poke &h7fff,&h55        
  51.     
  52.     If Peek(&h7ffe)=&haa and Peek(&h7fff)=&h55 then
  53.       Hercules.status%=1        ' if the change "took", then Herc is there
  54.       Goto Replace.bytes        ' and we are finished.
  55.     End If
  56.     
  57. ' This is a second test in case the memory test above failed because the
  58. ' Hercules adapter was in 'diagnostic' mode.
  59.  
  60.     Config.port%=&h03bf        ' the Hercules configuration port
  61.     Out Config.port%,1        ' Allow graphics only on page 0
  62.  
  63.                     ' Now try to change it again
  64.                     
  65.     Poke &h7ffe,&haa        ' Our signature is &h55aa
  66.     Poke &h7fff,&h55        
  67.     
  68.     If Peek(&h7ffe)=&haa and Peek(&h7fff)=&h55 then
  69.       Hercules.status%=1        ' if the change "took", then Herc is there
  70.     End If
  71.     
  72. Replace.bytes:
  73.  
  74.     Poke &h7ffe,Low.byte%        ' put it back the way it was
  75.     Poke &H7fff,High.byte%        ' ditto
  76.     Def Seg                ' BACK TO basic'S DEFAULT SEGMENT
  77.         
  78. End Sub
  79.  
  80.